home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / t_os / demo / takara / seitakak.bas < prev    next >
Encoding:
BASIC Source File  |  1995-08-18  |  9.4 KB  |  261 lines

  1. 1000 SCREEN@ 0:CLS:KY=0:MY=0:SETUMEI=0
  2. 1010 DEF FONT "システム   16ドット"
  3. 1020 '
  4. 1030 *GAMEN_1
  5. 1040 REM ****WAKU EGAKU ************************************************
  6. 1050  FOR J=0 TO 16 STEP 2
  7. 1060    LINE(J,20+J)-(630-J,476-J),PSET,5,B
  8. 1070  NEXT
  9. 1080  LINE(40,420)-(596,423),PSET,5,BF
  10. 1090 '
  11. 1100  COLOR 6
  12. 1110  LOCATE 25, 5:PRINT "TOWNS 君が作る正多角形ですよ";
  13. 1120  LOCATE 25, 7:PRINT "●  初めての人(サンプル付き)";
  14. 1130  LOCATE 25, 9:PRINT "●  2度目の人(サンプルなし)";
  15. 1140  LOCATE 25,11:PRINT "HELP で希望の正多角形の頂角の";
  16. 1150  LOCATE 25,12:PRINT "     内角の大きさを知ることが";
  17. 1160  LOCATE 25,13:PRINT "     できます。";
  18. 1170  LINE (152,301)-(476,301),PSET,5
  19. 1180  LOCATE 24,17:PRINT "どちらかの ● をクリックしてね";
  20. 1190  LOCATE 24,19:PRINT "        おまけもあるよ";
  21. 1200  LOCATE 24,21:COLOR 7:PRINT "おまけ1   おまけ2   おまけ3";:COLOR 6
  22. 1210  LINE (188,396)-(254,417),PSET,7,B:LINE (276,396)-(344,417),PSET,7,B
  23. 1220  LINE (364,396)-(431,417),PSET,7,B
  24. 1230 '
  25. 1240  MOUSE 5:MOUSE 0:MOUSE 1,444,155,1
  26. 1250  X=MOUSE(4,0):Y=MOUSE(5,0)
  27. 1260  IF X>197 AND X<425 AND Y>131 AND Y<150 THEN KY=0:GOTO *KESU
  28. 1270  IF X>196 AND X<423 AND Y>169 AND Y<189 THEN KY=1:GOTO *HAYASA
  29. 1280  IF X>188 AND X<254 AND Y>396 AND Y<417 THEN      GOTO *OMAKE1
  30. 1290  IF X>276 AND X<344 AND Y>396 AND Y<417 THEN      GOTO *OMAKE2
  31. 1300  IF X>364 AND X<431 AND Y>396 AND Y<417 THEN      GOTO *OMAKE3
  32. 1310  GOTO 1250
  33. 1320 '
  34. 1330 *HAYASA
  35. 1340  LINE(187,395)-(432,418),PSET,0,BF:CLS 4
  36. 1350  LOCATE 26, 7:PRINT "●  多角形を, 高速で描く";
  37. 1360  LOCATE 26, 9:PRINT "●  多角形を, 低速で描く";
  38. 1370  LOCATE 24,18:PRINT "どちらかの ● をクリックしてね";
  39. 1380 '
  40. 1390  MOUSE 5:MOUSE 0:MOUSE 1,444,155,1
  41. 1400  X=MOUSE(4,0):Y=MOUSE(5,0)
  42. 1410  IF X>197 AND X<425 AND Y>131 AND Y<150 THEN HY_SYOKI=1:GOTO *SETUMEI
  43. 1420  IF X>196 AND X<423 AND Y>169 AND Y<189 THEN HY_SYOKI=0:GOTO *SETUMEI
  44. 1430  GOTO 1400
  45. 1440 '
  46. 1450 *SETUMEI
  47. 1460  CLS 4
  48. 1470  LOCATE 29, 7:PRINT "●  説明を付ける。";
  49. 1480  LOCATE 29, 9:PRINT "●  説明を付けない。";
  50. 1490  LOCATE 24,18:PRINT "どちらかの ● をクリックしてね";
  51. 1500 '
  52. 1510  MOUSE 5:MOUSE 0:MOUSE 1,444,155,1
  53. 1520  X=MOUSE(4,0):Y=MOUSE(5,0)
  54. 1530  IF X>197 AND X<425 AND Y>131 AND Y<150 THEN SETUMEI=0:GOTO *KESU
  55. 1540  IF X>196 AND X<423 AND Y>169 AND Y<189 THEN SETUMEI=1:GOTO *KESU
  56. 1550  GOTO 1520
  57. 1560 '
  58. 1570 *KESU
  59. 1580  MOUSE 5:CLS 4:LINE (152,301)-(476,301),PSET,0
  60. 1590  LINE(187,395)-(432,418),PSET,0,BF
  61. 1600  GOTO *GAMEN
  62. 1610 '
  63. 1620 *GAMEN
  64. 1630  LINE(152,228)-(488,228),PSET,2
  65. 1640  LINE(320, 60)-(320,395),PSET,2
  66. 1650 '
  67. 1660  LINE(180, 60)-(180,395),PSET,7,,&H6666
  68. 1670  LINE(250, 60)-(250,395),PSET,7,,&H6666
  69. 1680  LINE(390, 60)-(390,395),PSET,7,,&H6666
  70. 1690  LINE(460, 60)-(460,395),PSET,7,,&H6666
  71. 1700  LINE(152, 88)-(488, 88),PSET,7,,&H6666
  72. 1710  LINE(152,158)-(488,158),PSET,7,,&H6666
  73. 1720  LINE(152,298)-(488,298),PSET,7,,&H6666
  74. 1730  LINE(152,368)-(488,368),PSET,7,,&H6666
  75. 1740 '
  76. 1750  SYMBOL (309,231),"0", 1,1,7,0,PSET,0,2
  77. 1760 '
  78. 1770  SYMBOL (298,371),"-1",1,1,7,0,PSET,0,2
  79. 1780  SYMBOL (309, 91),"1", 1,1,7,0,PSET,0,2
  80. 1790 '
  81. 1800  SYMBOL (158,231),"-1",1,1,7,0,PSET,0,2
  82. 1810  SYMBOL (449,231),"1", 1,1,7,0,PSET,0,2
  83. 1820 '
  84. 1830 REM COMENT KAKIKOMU ****************************
  85. 1840  IF KY=1 THEN GOTO *MAIN_PRO
  86. 1850  COLOR 6
  87. 1860  LOCATE 7, 23:PRINT "Townsくんが, 君が入力した角度を頂角に持つ正多角形を描いてくれるよ。";
  88. 1870  WAIT 500:LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  89. 1880  LOCATE 7, 23:PRINT "例えばさ, 正三角形の頂角は, 60度だよね。  だから・・・・・・・";
  90. 1890  WAIT 300:LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  91. 1900  LOCATE 7, 23:PRINT "キーボードから60と入れ, リターンキーを押すと・・・ 正三角形を描くよ。";
  92. 1910  WAIT 100
  93. 1920  LOCATE 7,3:COLOR 6:INPUT "何度";XTH!
  94. 1930  LOCATE 7,3:PRINT "               ";
  95. 1940  IF XTH=60 THEN GOTO *MAIN_PRO
  96. 1950  LOCATE 7,3:COLOR 6:PRINT "60と入れてね。";
  97. 1960  WAIT 200:LOCATE 7,3:PRINT "               ";
  98. 1970  GOTO 1920
  99. 1980 '
  100. 1990 *MAIN_PRO
  101. 2000  IF KY=0 THEN GOTO *MAIN_PRO_2
  102. 2010  IF MY=1 THEN GOTO 2030
  103. 2020  LOCATE 38,23:COLOR 7:PRINT " 始める   HELP   終わる   メニューへ";:GOTO 2040
  104. 2030  LOCATE 38,23:COLOR 7:PRINT " 続ける   HELP   終わる   メニューへ";
  105. 2040  LINE (308,434)-(363,455),PSET,7,B
  106. 2050  LINE (379,434)-(419,455),PSET,7,B
  107. 2060  LINE (435,434)-(490,455),PSET,7,B
  108. 2070  LINE (506,434)-(596,455),PSET,7,B
  109. 2080 '
  110. 2090  MOUSE 5:MOUSE 0:MOUSE 1,494,402,1
  111. 2100  X=MOUSE(4,0):Y=MOUSE(5,0)
  112. 2110  IF X>308 AND X<363 AND Y>434 AND Y<455 THEN GOTO *MAIN_PRO_1
  113. 2120  IF X>379 AND X<419 AND Y>434 AND Y<455 THEN HEY=1:GOTO *HELP
  114. 2130  IF X>435 AND X<490 AND Y>434 AND Y<455 THEN SYSTEM
  115. 2140  IF X>506 AND X<596 AND Y>434 AND Y<455 THEN GOTO *MENU_HE
  116. 2150  GOTO 2100
  117. 2160 '
  118. 2170 *HELP
  119. 2180  LINE (308,434)-(600,455),PSET,0,BF:MOUSE 5
  120. 2190  LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  121. 2200  LOCATE 7,23:COLOR 6:PRINT "何角形の, 頂角の大きさを知りたいのかな?";
  122. 2210  LOCATE 7,3:COLOR 6:INPUT "何角形";KAK
  123. 2220  D=(KAK-2)*180/KAK
  124. 2230  LOCATE 7,3 :PRINT "                   ";
  125. 2240  LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  126. 2250  LOCATE 5,23:PRINT KAK;"角形の, 頂角の大きさは, ";D;"度です。キーボードから角度を入れてね";
  127. 2260  GOTO *MAIN_PRO_1'
  128. 2270 '
  129. 2280 '
  130. 2290 *MAIN_PRO_1
  131. 2300  IF HEY=1 THEN GOTO 2320
  132. 2310  LINE (308,434)-(600,455),PSET,0,BF:CLS 4:MOUSE 5
  133. 2320  LOCATE 7,3:COLOR 6:INPUT "何度";XTH!
  134. 2330  LOCATE 7,3:PRINT "                           ";
  135. 2340  IF XTH<180 THEN GOTO *MAIN_PRO_2
  136. 2350  LOCATE 7,3:COLOR 6:PRINT "180より小さい数を入れてね。";
  137. 2360  WAIT 200:LOCATE 7,3:PRINT "                           ";
  138. 2370  GOTO 2320
  139. 2380 '
  140. 2390 *MAIN_PRO_2
  141. 2400  LOCATE 5,23:PRINT SPACE$(75);:WAIT 50
  142. 2410  LOCATE 7, 23:PRINT "一つの頂角が";XTH;"゜の多角形を描くよ。よく見てくれよ。";
  143. 2420  WAIT 100
  144. 2430 '
  145. 2440  LINE (507,340)-(591,417),PSET,7,B
  146. 2450  PI=3.14159!:TH=0:CHECK=1:KAKU=0
  147. 2460  THT=(180-XTH)/2
  148. 2470  B=280*COS(TH*PI/180)*COS(TH*PI/180)
  149. 2480  A=280*COS(TH*PI/180)*SIN(TH*PI/180)
  150. 2490  C0=40+280-A:D0=228-B+140
  151. 2500  POINT(C0,D0)
  152. 2510 '
  153. 2520  HY=HY_SYOKI
  154. 2530  IF HY=1 THEN GOTO 2580
  155. 2540  LOCATE 64, 18:COLOR 4:PRINT "マウスを";
  156. 2550  LOCATE 64, 19:COLOR 4:PRINT "左クリック";
  157. 2560  LOCATE 64, 20:COLOR 4:PRINT "すると";
  158. 2570  LOCATE 64, 21:COLOR 4:PRINT "速くなるよ";:GOTO 2620
  159. 2580  LOCATE 64, 18:COLOR 7:PRINT "マウスを";
  160. 2590  LOCATE 64, 19:COLOR 7:PRINT "左クリック";
  161. 2600  LOCATE 64, 20:COLOR 7:PRINT "すると";
  162. 2610  LOCATE 64, 21:COLOR 7:PRINT "遅くなるよ";
  163. 2620  '
  164. 2630  MOUSE 5:MOUSE 0
  165. 2640  FOR TH=0 TO 35720 STEP THT
  166. 2650    XM=MOUSE(3,0)
  167. 2660    IF XM=0 THEN GOTO 2790
  168. 2670       IF HY=0 THEN HY=1 ELSE HY=0
  169. 2680       IF HY=1 THEN GOTO 2740
  170. 2690          LOCATE 64, 18:COLOR 4:PRINT "マウスを";
  171. 2700          LOCATE 64, 19:COLOR 4:PRINT "左クリック";
  172. 2710          LOCATE 64, 20:COLOR 4:PRINT "すると";
  173. 2720          LOCATE 64, 21:COLOR 4:PRINT "速くなるよ";:GOTO 2780
  174. 2730 '
  175. 2740          LOCATE 64, 18:COLOR 7:PRINT "マウスを";
  176. 2750          LOCATE 64, 19:COLOR 7:PRINT "左クリック";
  177. 2760          LOCATE 64, 20:COLOR 7:PRINT "すると";
  178. 2770          LOCATE 64, 21:COLOR 7:PRINT "遅くなるよ";
  179. 2780       XM=0
  180. 2790    B=280*COS(TH*PI/180)*COS(TH*PI/180)
  181. 2800    A=280*COS(TH*PI/180)*SIN(TH*PI/180)
  182. 2810    C=40+280-A:D=228-B+140
  183. 2820 '
  184. 2830    LINE -(C,D),PSET,4'CIRCLE (C,D),3,2,,,,F,PSET,2
  185. 2840    C1=ABS(C-C0):D1=ABS(D-D0)
  186. 2850    IF CHECK=1 THEN GOTO 2870
  187. 2860    IF C1<.5! AND D1<.5! THEN GOTO *MAIN_COMENT
  188. 2870    CHECK=CHECK+1:KAKU=KAKU+1
  189. 2880    IF HY=1 THEN GOTO 2900
  190. 2890    WAIT 50
  191. 2900  NEXT'
  192. 2910 ' 
  193. 2920 *MAIN_COMENT 
  194. 2930  LINE (506,339)-(592,418),PSET,0,BF:CLS 4
  195. 2940  GOSUB *KEISAN
  196. 2950  '
  197. 2960  IF SETUMEI=1 THEN GOTO 3060
  198. 2970  LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  199. 2980  IF SEI=0 THEN GOTO 3000 
  200. 2990  LOCATE 7, 23:COLOR 6:PRINT "頂角が";XTH;"度だと, 正";KAKU;"角形になるんだね!";:GOTO 3010
  201. 3000  LOCATE 7, 23:COLOR 6:PRINT "頂角が";XTH;"度だと, ";KAKU;"個の頂点を持つ星型正多角形になるんだね!";
  202. 3010  IF XTH>160 THEN GOTO 3150
  203. 3020  WAIT 300:LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  204. 3030  LOCATE 7, 23:PRINT "円を描くよ。 正多角形なので, 円に内接するよ。";
  205. 3040  WAIT 300 
  206. 3050  ' 
  207. 3060  IF XTH>160 THEN GOTO 3090
  208. 3070  WAIT 75:CIRCLE (320,228),140,5
  209. 3080  IF SETUMEI=1 THEN GOTO 3120
  210. 3090  WAIT 300
  211. 3100 '
  212. 3110  LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  213. 3120  IF SEI=0 THEN GOTO 3140 
  214. 3130  LOCATE 7, 23:COLOR 6:PRINT "頂角が";XTH;"度だと, 正";KAKU;"角形になるんだね!分かったかい?";:GOTO 3150
  215. 3140  LOCATE 7, 23:COLOR 6:PRINT "頂角が";XTH;"度だと, ";KAKU;"個の頂点を持つ星型正多角形になるんだね!";
  216. 3150  WAIT 300:LOCATE 7,23:PRINT SPACE$(70);:WAIT 50
  217. 3160  IF SETUMEI=1 THEN GOTO 3200
  218. 3170  LOCATE 7, 23:PRINT "では, 自分で好きな数を入れてためしてみて。";
  219. 3180  WAIT 200
  220. 3190 '
  221. 3200  CLS 4:LINE (150,59)-(489,369),PSET,0,BF
  222. 3210  HEY=0:KY=1:MY=1:GOTO *GAMEN
  223. 3220 '
  224. 3230 *MOUS
  225. 3240  MOUSE 0:MOUSE 1,100,100,1
  226. 3250  X=MOUSE(4,0):Y=MOUSE(5,0)
  227. 3260  LOCATE 0,23:PRINT X;Y;
  228. 3270  GOTO 3250
  229. 3280  '
  230. 3290 *KEISAN
  231. 3300  LOCATE 7,23:PRINT SPACE$(60);
  232. 3310  XTH$=STR$(XTH)
  233. 3320  FOR H=1 TO 360
  234. 3330    D1=(H-2)*180/H
  235. 3340    D1$=STR$(D1)
  236. 3350    IF D1$=XTH$ THEN GOTO 3380
  237. 3360  NEXT
  238. 3370  SEI=0:GOTO 3390
  239. 3380  SEI=1
  240. 3390  RETURN
  241. 3400 '
  242. 3410 *MENU_HE
  243. 3420  MOUSE 5:LINE (307,432)-(297,456),PSET,0,BF
  244. 3430  CHAIN "MENU2.BAS",,ALL
  245. 3440  RUN "MENU2.BAS"
  246. 3450 '
  247. 3460 *OMAKE1
  248. 3465  MOUSE 5
  249. 3470  CHAIN "OMAKE1.BAS",,ALL
  250. 3480  RUN "OMAKE1.BAS"
  251. 3490 '
  252. 3500 *OMAKE2
  253. 3505  MOUSE 5
  254. 3510  CHAIN "OMAKE2.BAS",,ALL
  255. 3520  RUN "OMAKE2.BAS"
  256. 3530 '
  257. 3540 *OMAKE3
  258. 3545  MOUSE 5
  259. 3550  CHAIN "OMAKE3.BAS",,ALL
  260. 3560  RUN "OMAKE3.BAS"
  261.